home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / gnu_tile_forth.lha / tst / channels.tst < prev    next >
Text File  |  1992-05-19  |  1KB  |  72 lines
  1. .( Loading Multi-tasking channel test...) cr
  2.  
  3. #include multi-tasking.f83
  4.  
  5. structures multi-tasking
  6.  
  7.  
  8. .( 1: Channel and functions for wire binding to task functional units)
  9.  
  10. ONE-TO-ONE CHAN binding ( -- chan)
  11.  
  12. : bind ( x -- )  binding receive swap ! ;
  13. : wire ( x -- )  binding send ;
  14. : WIRE ( -- )    ONE-TO-ONE CHAN this wire ;
  15.  
  16.  
  17. .( 2: Use a task and three channels to multiply two numbers) cr
  18.  
  19. 16 16 task.type MULTIPLY ( -- )
  20.   ptr a ( -- addr)
  21.   ptr b ( -- addr)
  22.   ptr c ( -- addr)
  23. task.body
  24.   a bind b bind c bind
  25.   begin
  26.     a @ receive b @ receive * c @ send
  27.   again
  28. task.end
  29.  
  30. MULTIPLY m1 WIRE w1 WIRE w2 WIRE w3
  31.  
  32. : * ( x y -- z)  w1 send w2 send w3 receive ;
  33.  
  34. 100 90 * . cr
  35.  
  36.  
  37. .( 3: Run factorial as a task with two channels using the multiply task) cr
  38.  
  39. 16 16 task.type FACTORIAL ( -- )
  40.   ptr a ( -- addr)
  41.   ptr b ( -- addr)
  42. task.body 
  43.   a bind b bind
  44.   begin
  45.     1 a @ receive 1+ 1 do
  46.       i * 
  47.     loop
  48.     b @ send
  49.   again
  50. task.end
  51.  
  52. FACTORIAL f1 WIRE n WIRE n!
  53.  
  54. : fac ( n -- n!)
  55.   n send
  56.   ." I'm waiting.."
  57.   begin
  58.     n! ?avail not
  59.   while
  60.     ." .."
  61.     1 delay
  62.   repeat
  63.   ." done" cr
  64.   n! receive
  65. ;
  66.  
  67. 5 fac . cr
  68.  
  69. forth only
  70.  
  71.  
  72.